Sub ExportToPDF()
    Dim rng As Range, area As Range
    Dim tempSheet As Worksheet, ws As Worksheet
    Dim outputPath As String
    Dim nextRow As Long
    Dim usedCols As Range, col As Range

    Set ws = ActiveSheet
    On Error Resume Next: Set rng = Selection: On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "Please select at least one range.", vbExclamation
        Exit Sub
    End If

    ' Speed up performance
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ' Add temporary sheet
    Set tempSheet = ThisWorkbook.Sheets.Add

    ' Copy only used column widths from the selected range
    Set usedCols = Intersect(ws.UsedRange, rng.EntireColumn)
    If Not usedCols Is Nothing Then
        For Each col In usedCols.Columns
            tempSheet.Columns(col.Column).ColumnWidth = ws.Columns(col.Column).ColumnWidth
        Next col
    End If

    ' Match page setup
    With tempSheet.PageSetup
        .Orientation = ws.PageSetup.Orientation
        .PaperSize = ws.PageSetup.PaperSize
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With

    ' Copy each selected area and preserve all formatting and hyperlinks
    nextRow = 1
    For Each area In rng.Areas
        area.Copy
        tempSheet.Paste Destination:=tempSheet.Cells(nextRow, 1)
        nextRow = nextRow + area.Rows.Count
    Next area

    Application.CutCopyMode = False

    ' Prompt for save location
    outputPath = Application.GetSaveAsFilename("NonContiguousRanges.pdf", "PDF Files (*.pdf), *.pdf")
    If outputPath = "False" Then GoTo Cleanup

    tempSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=outputPath, Quality:=xlQualityStandard

Cleanup:
    Application.DisplayAlerts = False: tempSheet.Delete: Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    If outputPath <> "False" Then MsgBox "PDF saved to: " & outputPath, vbInformation
End Sub